home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / pascal / o_gem / source / xaccspy / xaccspy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-22  |  19.6 KB  |  691 lines
  1. {$IFDEF DEBUG}
  2.     {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z+}
  3. {$ELSE}
  4.     {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z+}
  5. {$ENDIF}
  6.  
  7. program XAccSpy;
  8.  
  9. uses
  10.  
  11.     Gem,OTypes,OProcs,OWindows,OValidat,ODialogs,OStdWnds;
  12.  
  13. const
  14.  
  15.     XSVER = '09.09.1994';
  16.     {$I xaccspy.i}
  17.  
  18. type
  19.  
  20.     TRNSBUFFER = record
  21.         hlen : string[5];
  22.         hprot,
  23.         wsave: integer
  24.     end;
  25.  
  26.     PMyTextWindow = ^TMyTextWindow;
  27.     TMyTextWindow = object(TTextWindow)
  28.         procedure SetupSize; virtual;
  29.     end;
  30.  
  31.     PXAccApplication = ^TXAccApplication;
  32.     TXAccApplication = object(TApplication)
  33.         tbuffer: TRNSBUFFER;
  34.         HWind  : PMyTextWindow;
  35.         function GetIconTitle: string; virtual;
  36.         procedure InitInstance; virtual;
  37.         procedure InitMainWindow; virtual;
  38.         function XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean; virtual;
  39.         procedure XAccExit(OrgID: integer); virtual;
  40.         function AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean; virtual;
  41.         procedure AVExit(OrgID: integer); virtual;
  42.         procedure MUMesag(data: TEventData); virtual;
  43.     end;
  44.  
  45.     PXAccWindow = ^TXAccWindow;
  46.     TXAccWindow = object(TDialog)
  47.         InfoWnd: PDialog;
  48.         destructor Done; virtual;
  49.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  50.         procedure SetupSize; virtual;
  51.         procedure SetupWindow; virtual;
  52.         function GetIconTitle: string; virtual;
  53.         function GetStyle: integer; virtual;
  54.         procedure UpdateDialog; virtual;
  55.         procedure GetWorkMax(var maxX,maxY: integer); virtual;
  56.         procedure Paint(var PaintInfo: TPaintStruct); virtual;
  57.         procedure IconPaint(var PaintInfo: TPaintStruct); virtual;
  58.         procedure WMRButton(mX,mY,KStat,Clicks: integer); virtual;
  59.         function ExitDlg(AnIndx: integer): boolean; virtual;
  60.         function OK: boolean; virtual;
  61.         function Help: boolean; virtual;
  62.     end;
  63.  
  64.     PAbout = ^TAbout;
  65.     TAbout = object(TMenu)
  66.         procedure Work; virtual;
  67.     end;
  68.  
  69.     PHelp = ^THelp;
  70.     THelp = object(TMenu)
  71.         procedure Work; virtual;
  72.     end;
  73.  
  74.     PQuit = ^TQuit;
  75.     TQuit = object(TMenu)
  76.         procedure Work; virtual;
  77.     end;
  78.  
  79.     PHistory = ^THistory;
  80.     THistory = object(TMenu)
  81.         procedure Work; virtual;
  82.     end;
  83.  
  84.     PSetup = ^TSetup;
  85.     TSetup = object(TMenu)
  86.         procedure Work; virtual;
  87.     end;
  88.  
  89.     PInfButton = ^TInfButton;
  90.     TInfButton = object(TButton)
  91.         tbuf: TRNSBUFFER;
  92.         procedure Changed(AnIndx: integer; DblClick: boolean); virtual;
  93.     end;
  94.  
  95. var
  96.  
  97.     XAccApplication: TXAccApplication;
  98.  
  99.  
  100. procedure XSResource; external;  {$L xaccspy.o}
  101.  
  102.  
  103.  
  104. procedure TMyTextWindow.SetupSize;
  105.  
  106.     begin
  107.         inherited SetupSize;
  108.         SliceMouse;
  109.         Curr.X:=GetPrivateProfileInt('History','Window.X',Curr.X,'XACCSPY.INF');
  110.         SliceMouseNext;
  111.         Curr.Y:=GetPrivateProfileInt('History','Window.Y',Curr.Y,'XACCSPY.INF');
  112.         SliceMouseNext;
  113.         Curr.W:=GetPrivateProfileInt('History','Window.W',Curr.W,'XACCSPY.INF');
  114.         SliceMouseNext;
  115.         Curr.H:=GetPrivateProfileInt('History','Window.H',Curr.H,'XACCSPY.INF');
  116.         ArrowMouse;
  117.         GRtoA2(Curr);
  118.         Calc(WC_WORK,Curr,Work);
  119.         Class.Style:=Class.Style and not(cs_AutoOpen);
  120.         DisableAutoCreate
  121.     end;
  122.  
  123.  
  124. function TXAccApplication.GetIconTitle: string;
  125.  
  126.     begin
  127.         GetIconTitle:='XACC-SPY'
  128.     end;
  129.  
  130.  
  131. procedure TXAccApplication.InitInstance;
  132.  
  133.     begin
  134.         HWind:=nil;
  135.         OpenPrivateProfile('XACCSPY.INF');
  136.         InitResource(@XSResource,nil);
  137.         LoadIcon(XSICON,XSICNSPY);
  138.         SliceMouse;
  139.         with tbuffer do
  140.             begin
  141.                 hlen:=GetPrivateProfileString('History','Length','50','XACCSPY.INF');
  142.                 SliceMouseNext;
  143.                 hprot:=GetPrivateProfileInt('History','Save',bf_Checked,'XACCSPY.INF');
  144.                 SliceMouseNext;
  145.                 wsave:=GetPrivateProfileInt('Setup','Save',bf_Unchecked,'XACCSPY.INF')
  146.             end;
  147.         ArrowMouse;
  148.         inherited InitInstance;
  149.         new(HWind,Init(MainWindow,'HISTORY (XAcc-Spy)',atol(tbuffer.hlen),0))
  150.     end;
  151.  
  152.  
  153. procedure TXAccApplication.InitMainWindow;
  154.     var p: PXAccWindow;
  155.  
  156.     begin
  157.         new(p,Init(nil,'ObjectGEM XAcc-Spy',XSWINDOW));
  158.         if (MainWindow=nil) or (ChkError<em_OK) then Status:=em_InvalidMainWindow
  159.         else
  160.             begin
  161.                 new(PButton,Init(p,XSWINFO,id_No,true,'Zeigt Informationen über XAcc-Spy an.'));
  162.                 new(PButton,Init(p,XSWHELP,id_Help,false,'Zeigt einen Hilfstext an.'));
  163.                 if AppFlag then p^.MakeWindow
  164.             end
  165.     end;
  166.  
  167.  
  168. procedure ZeichneNeu(p: PWindow);
  169.  
  170.     begin
  171.         p^.ForceRedraw
  172.     end;
  173.  
  174.  
  175. function TXAccApplication.XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean;
  176.  
  177.     begin
  178.         XAccInsert:=inherited XAccInsert(accID,mID,Msg,Ver,pName);
  179.         ForEachWnd(@ZeichneNeu)
  180.     end;
  181.  
  182.  
  183. procedure TXAccApplication.XAccExit(OrgID: integer);
  184.  
  185.     begin
  186.         inherited XAccExit(OrgID);
  187.         ForEachWnd(@ZeichneNeu)
  188.     end;
  189.  
  190.  
  191. function TXAccApplication.AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean;
  192.  
  193.     begin
  194.         AVInsert:=inherited AVInsert(accID,SrvMsg,AccMsg,AName);
  195.         ForEachWnd(@ZeichneNeu)
  196.     end;
  197.  
  198.  
  199. procedure TXAccApplication.AVExit(OrgID: integer);
  200.  
  201.     begin
  202.         inherited AVExit(OrgID);
  203.         ForEachWnd(@ZeichneNeu)
  204.     end;
  205.  
  206.  
  207. procedure TXAccApplication.MUMesag(data: TEventData);
  208.     label _add;
  209.  
  210.     var nline : string;
  211.         xattr : TXAccAttr;
  212.         pc    : PChar;
  213.         finish: integer;
  214.  
  215.     procedure Add(line: string);
  216.  
  217.         begin
  218.             if HWind=nil then exit;
  219.             while HWind^.GetNumLines>=atol(tbuffer.hlen) do HWind^.DeleteLine(0);
  220.             HWind^.AddLine(line)
  221.         end;
  222.  
  223.     begin
  224.         if (data.Pipe[0]=ACC_EXIT) or (data.Pipe[0]=AV_EXIT) then
  225.             if tbuffer.hprot=bf_Checked then
  226.                 begin
  227.                     xattr.Name:=nil;
  228.                     FindApplication('',data.Pipe[1],xattr);
  229.                     if xattr.Name<>nil then nline:=xattr.Name^
  230.                     else
  231.                         nline:='??? Prozeß #'+ltoa(data.Pipe[1]);
  232.                     nline:=' '+nline+':'+StrPSpace(16-length(nline))+'  ';
  233.                     if data.Pipe[0]=ACC_EXIT then nline:=nline+'ACC_EXIT'
  234.                     else
  235.                         nline:=nline+'AV_EXIT';
  236.                     Add(nline)
  237.                 end;
  238.         inherited MUMesag(data);
  239.         if tbuffer.hprot<>bf_Checked then exit;
  240.         case data.Pipe[0] of
  241.         ACC_ID..ACC_ACC,ACC_ACK..ACC_IMG,AV_PROTOKOLL,VA_PROTOSTATUS:
  242.             begin
  243.                 xattr.Name:=nil;
  244.                 FindApplication('',data.Pipe[1],xattr);
  245.                 if xattr.Name<>nil then nline:=xattr.Name^
  246.                 else
  247.                     nline:='Prozeß '+ltoa(data.Pipe[1]);
  248.                 nline:=' '+nline+':'+StrPSpace(16-length(nline))+'  ';
  249.                 case data.Pipe[0] of
  250.                     ACC_ID:
  251.                         nline:=nline+'ACC_ID';
  252.                     ACC_OPEN:
  253.                         nline:=nline+'ACC_OPEN';
  254.                     ACC_CLOSE:
  255.                         nline:=nline+'ACC_CLOSE';
  256.                     ACC_ACC:
  257.                         nline:=nline+'ACC_ACC';
  258.                     ACC_ACK:
  259.                         nline:=nline+'ACC_ACK';
  260.                     ACC_TEXT:
  261.                         nline:=nline+'ACC_TEXT';
  262.                     ACC_KEY:
  263.                         nline:=nline+'ACC_KEY';
  264.                     ACC_META:
  265.                         nline:=nline+'ACC_META';
  266.                     ACC_IMG:
  267.                         nline:=nline+'ACC_IMG';
  268.                     AV_PROTOKOLL:
  269.                         nline:=nline+'AV_PROTOKOLL';
  270.                     VA_PROTOSTATUS:
  271.                         nline:=nline+'VA_PROTOSTATUS'
  272.                 end;
  273.                 nline:=nline+StrPSpace(36-length(nline))+'[3]='+ltoa(data.Pipe[3])+' [4]='+ltoa(data.Pipe[4])+' [5]='+ltoa(data.Pipe[5])+' [6]='+ltoa(data.Pipe[6])+' [7]='+ltoa(data.Pipe[7]);
  274.                 if (data.Pipe[0]=ACC_ID) or (data.Pipe[0]=ACC_ACC) then
  275.                     begin
  276.                         nline:=nline+'  ';
  277.                         pc:=Ptr(word(data.Pipe[4]),word(data.Pipe[5]));
  278.                         if longint(pc)<=$7fff then
  279.                             begin
  280.                                 nline:=nline+'*** fehlerhafter Pointer: '+ltoa(longint(pc));
  281.                                 goto _add
  282.                             end;
  283.                         finish:=0;
  284.                         while (length(nline)<255) and (finish<2) do
  285.                             begin
  286.                                 if pc^=#0 then
  287.                                     begin
  288.                                         nline:=nline+'.';
  289.                                         inc(finish)
  290.                                     end
  291.                                 else
  292.                                     begin
  293.                                         nline:=nline+pc^;
  294.                                         finish:=0
  295.                                     end;
  296.                                 inc(longint(pc))
  297.                             end
  298.                     end;
  299.                 _add:
  300.                 Add(nline)
  301.             end;
  302.         AC_CLOSE:
  303.             Add(' AES:           *** AC_CLOSE ***')
  304.         end
  305.     end;
  306.  
  307.  
  308. destructor TXAccWindow.Done;
  309.  
  310.     begin
  311.         with PXAccApplication(Application)^ do
  312.             if tbuffer.wsave=bf_Checked then
  313.                 begin
  314.                     SliceMouse;
  315.                     if WritePrivateProfileInt('Setup','Window.X',Curr.X,'XACCSPY.INF') then
  316.                         begin
  317.                             SliceMouseNext;
  318.                             WritePrivateProfileInt('Setup','Window.Y',Curr.Y,'XACCSPY.INF');
  319.                             SliceMouseNext;
  320.                             WritePrivateProfileInt('Setup','Window.W',Curr.W,'XACCSPY.INF');
  321.                             SliceMouseNext;
  322.                             WritePrivateProfileInt('Setup','Window.H',Curr.H,'XACCSPY.INF');
  323.                             if HWind<>nil then
  324.                                 begin
  325.                                     SliceMouseNext;
  326.                                     WritePrivateProfileInt('History','Window.X',HWind^.Curr.X,'XACCSPY.INF');
  327.                                     SliceMouseNext;
  328.                                     WritePrivateProfileInt('History','Window.Y',HWind^.Curr.Y,'XACCSPY.INF');
  329.                                     SliceMouseNext;
  330.                                     WritePrivateProfileInt('History','Window.W',HWind^.Curr.W,'XACCSPY.INF');
  331.                                     SliceMouseNext;
  332.                                     WritePrivateProfileInt('History','Window.H',HWind^.Curr.H,'XACCSPY.INF')
  333.                                 end
  334.                         end;
  335.                     ArrowMouse
  336.                 end;
  337.         inherited Done
  338.     end;
  339.  
  340.  
  341. procedure TXAccWindow.GetWindowClass(var AWndClass: TWndClass);
  342.  
  343.     begin
  344.         inherited GetWindowClass(AWndClass);
  345.         with AWndClass do
  346.             begin
  347.                 Style:=Style or cs_CreateOnAccOpen or cs_FullRedraw or cs_UserToolbar;
  348.                 hbrBackground:=White+1
  349.             end
  350.     end;
  351.  
  352.  
  353. procedure TXAccWindow.SetupSize;
  354.  
  355.     begin
  356.         inherited SetupSize;
  357.         SliceMouse;
  358.         Curr.X:=GetPrivateProfileInt('Setup','Window.X',Curr.X,'XACCSPY.INF');
  359.         SliceMouseNext;
  360.         Curr.Y:=GetPrivateProfileInt('Setup','Window.Y',Curr.Y,'XACCSPY.INF');
  361.         SliceMouseNext;
  362.         Curr.W:=GetPrivateProfileInt('Setup','Window.W',Curr.W,'XACCSPY.INF');
  363.         SliceMouseNext;
  364.         Curr.H:=GetPrivateProfileInt('Setup','Window.H',Curr.H,'XACCSPY.INF');
  365.         ArrowMouse;
  366.         GRtoA2(Curr);
  367.         Calc(WC_WORK,Curr,Work)
  368.     end;
  369.  
  370.  
  371. procedure TXAccWindow.SetupWindow;
  372.     var p : PToolbar;
  373.         pq: PQuit;
  374.  
  375.     begin
  376.         inherited SetupWindow;
  377.         Attr.ExStyle:=Attr.ExStyle and not(ws_ex_CenterOnce);
  378.         LoadMenu(XSMENU);
  379.         LoadToolbar(XSTOOL,false);
  380.         LoadIcon(new(PIcon,Init(@self,XSICON,XSICNSPY,0,0,false,false,'','')));
  381.         new(PAbout,Init(@self,XSMABOUT,nil,false));
  382.         new(PHelp,Init(@self,XSMHONH,nil,false));
  383.         new(pq,Init(@self,XSMQUIT,nil,false));
  384.         if not(AppFlag) then
  385.             if pq<>nil then pq^.Disable;
  386.         new(PHistory,Init(@self,XSMHIST,nil,false));
  387.         new(PSetup,Init(@self,XSMSETUP,nil,false));
  388.         p:=new(PToolbar,Init(@self,XSTOOL,XSTHIST,K_ALT,Alt_H,nil,false,false,'Öffnet ein Fenster, das alle empfangenen XAcc- und AV-Messages auflistet'));
  389.         if p<>nil then p^.SetMenuIndex(XSMHIST);
  390.         p:=new(PToolbar,Init(@self,XSTOOL,XSTSETUP,K_ALT,Alt_S,nil,false,false,'Öffnet das Setup-Fenster für diverse Einstellungen'));
  391.         if p<>nil then p^.SetMenuIndex(XSMSETUP);
  392.         InfoWnd:=nil
  393.     end;
  394.  
  395.  
  396. function TXAccWindow.GetIconTitle: string;
  397.  
  398.     begin
  399.         GetIconTitle:=Application^.GetIconTitle
  400.     end;
  401.  
  402.  
  403. function TXAccWindow.GetStyle: integer;
  404.  
  405.     begin
  406.         GetStyle:=TWindow.GetStyle { _nicht_ von TDialog! }
  407.     end;
  408.  
  409.  
  410. procedure TXAccWindow.UpdateDialog;
  411.  
  412.     begin
  413.         inherited UpdateDialog;
  414.         if DlgTree<>nil then
  415.             with DlgTree^[ROOT] do
  416.                 begin
  417.                     ob_x:=Work.X2+1-ob_width;
  418.                     ob_y:=Work.Y2+1-ob_height
  419.                 end
  420.     end;
  421.  
  422.  
  423. procedure TXAccWindow.GetWorkMax(var maxX,maxY: integer);
  424.  
  425.     begin
  426.         maxX:=maxint;
  427.         maxY:=maxint
  428.     end;
  429.  
  430.  
  431. procedure TXAccWindow.Paint(var PaintInfo: TPaintStruct);
  432.     label _raus;
  433.  
  434.     var cnt,x,y,q,w,msk: integer;
  435.         txt,dummy      : string;
  436.  
  437.     begin
  438.         if Application^.XAccList<>nil then cnt:=Application^.XAccList^.Count
  439.         else
  440.             cnt:=0;
  441.         if cnt=0 then
  442.             begin
  443.                 SetSubTitle(' Keine XAcc-/AV-Applikation gefunden.');
  444.                 goto _raus
  445.             end
  446.         else
  447.             SetSubTitle(' '+ltoa(cnt)+' XAcc-/AV-Applikation(en) gefunden.');
  448.         x:=Work.X+GP.charWidth;
  449.         y:=Work.Y+GP.boxHeight;
  450.         v_gtext(vdiHandle,x,y,'Name              apID  meID  Ver  Groups  apType + Features + genName');
  451.         inc(y,GP.boxHeight shl 1);
  452.         for q:=0 to pred(cnt) do
  453.             with PXAccAttr(Application^.XAccList^.At(q))^ do
  454.                 begin
  455.                     if Name<>nil then txt:=Name^ else txt:='';
  456.                     txt:=txt+StrPSpace(16-length(Name^))+'  ';
  457.                     dummy:=ltoa(apID);
  458.                     txt:=txt+StrPSpace(3-length(dummy))+dummy+'   ';
  459.                     dummy:=ltoa(menuID);
  460.                     txt:=txt+StrPSpace(3-length(dummy))+dummy+'   ';
  461.                     dummy:=ltoa(Version);
  462.                     txt:=txt+StrPSpace(3-length(dummy))+dummy+'  ';
  463.                     msk:=1;
  464.                     if bTst(Protocol,PROTO_AV) then txt:=txt+'a' else txt:=txt+'_';
  465.                     if bTst(Protocol,PROTO_XACC) then txt:=txt+'x' else txt:=txt+'_';
  466.                     dummy:='';
  467.                     for w:=0 to 3 do
  468.                         begin
  469.                             if bTst(MsgGroups,msk) then dummy:=chr(w+49)+dummy
  470.                             else
  471.                                 dummy:='_'+dummy;
  472.                           msk:=msk shl 1
  473.                         end;
  474.                     txt:=txt+dummy+'  ';
  475.                     txt:=txt+AppTypeMR+' ';
  476.                     if AppTypeHR<>nil then txt:=txt+AppTypeHR^+'  ';
  477.                     if ExtFeatures<>nil then txt:=txt+ExtFeatures^+'  ';
  478.                     if GenericName<>nil then txt:=txt+GenericName^;
  479.                     v_gtext(vdiHandle,x,y,txt);
  480.                     inc(y,GP.boxHeight)
  481.                 end;
  482.         _raus:
  483.         inherited Paint(PaintInfo)
  484.     end;
  485.  
  486.  
  487. procedure TXAccWindow.IconPaint(var PaintInfo: TPaintStruct);
  488.     var cnt: integer;
  489.  
  490.     begin
  491.         if Icon<>nil then
  492.             begin
  493.                 if Application^.XAccList<>nil then cnt:=Application^.XAccList^.Count
  494.                 else
  495.                     cnt:=0;
  496.                 Icon^.SetText(ltoa(cnt)+' APP')
  497.             end
  498.     end;
  499.  
  500.  
  501. procedure TXAccWindow.WMRButton(mX,mY,KStat,Clicks: integer);
  502.     var num : integer;
  503.         answ: string;
  504.  
  505.     begin
  506.         if Application^.XAccList=nil then exit;
  507.         if mY-Work.Y<=GP.boxHeight then
  508.             begin
  509.                 if Application^.XAccList^.Count=0 then exit;
  510.                 num:=(mX-Work.X) div GP.boxWidth;
  511.                 if num<17 then
  512.                     answ:='Der Name der Applikation. XAcc-Programme verwenden meist einen gut lesbaren Namen, AV-Programme dagegen den Namen der Programmdatei.'
  513.                 else if (num>=18) and (num<=23) then
  514.                     answ:='Die AES-Prozeß-ID. Unter "normalem" TOS hat das Hauptprogramm die ID 0.'
  515.                 else if (num>=24) and (num<=29) then
  516.                     answ:='Die Nummer des Menüeintrags. Ist bei Accessories wichtig und wird von Programmen normalerweise auf -1 gesetzt.'
  517.                 else if (num>=30) and (num<=34) then
  518.                     answ:='Eine von der Applikation beliebig zu setzende Versionsnummer. Die Codierung ist nicht festgelegt.'
  519.                 else if (num>=35) and (num<=42) then
  520.                     answ:='Eine Bitmap der verstandenen XAcc-Message-Gruppen (v.r.n.l.). Eine akzeptierte Gruppe wird durch die entsprechende Zahl gekennzeichnet, sonst wird ein Unterstrich ausgegeben. '
  521.                           +'Links wird außerdem noch die Art des Protokolls angegeben (a=AV, x=XAcc).'                else if (num>=43) and (num<=50) then
  522.                     answ:='Der Applikations-Typ (optional). Die ersten beiden Großbuchstaben geben den maschinenlesbaren Typ an, dann folgt der "menschenlesbare".'
  523.                 else if (num>=51) and (num<=61) then
  524.                     answ:='Evtl. vorhandene erweiterte Möglichkeiten (optional). Der Inhalt ist nicht genormt, daher müssen Programme, die darauf zugreifen, das andere Programm kennen.'
  525.                 else
  526.                     answ:='Der sog. generische Name (optional). Kann verwendet werden, um ähnliche oder zusammengehörende Programme zu kennzeichnen.';
  527.                 Application^.BubbleHelp(mX,mY,500,answ)
  528.             end
  529.         else
  530.             begin
  531.                 num:=mY-Work.Y-2*GP.boxHeight-(GP.boxHeight shr 2);
  532.                 if (Clicks<>1) or (num<0) then exit;
  533.                 num:=num div GP.boxHeight;
  534.                 if num<Application^.XAccList^.Count then
  535.                     begin
  536.                         answ:=GetPrivateProfileString('Info',PXAccAttr(Application^.XAccList^.At(num))^.Name^,'','XACCSPY.INF');
  537.                         if length(answ)=0 then Application^.BubbleHelp(mX,mY,500,'Keine Informationen vorhanden.')
  538.                         else
  539.                             Application^.BubbleHelp(mX,mY,500,answ)
  540.                     end
  541.             end
  542.     end;
  543.  
  544.  
  545. function TXAccWindow.ExitDlg(AnIndx: integer): boolean;
  546.     var p: PStatic;
  547.  
  548.     begin
  549.         if AnIndx=XSWINFO then
  550.             begin
  551.                 if InfoWnd=nil then
  552.                     begin
  553.                         new(InfoWnd,Init(@self,'INFO (XAcc-Spy)',XSINFO));
  554.                         if InfoWnd<>nil then
  555.                             begin
  556.                                 new(p,Init(InfoWnd,XSIVER,28,true,'"Möge die OOP mit Euch sein!"'));
  557.                                 if p<>nil then p^.SetText('XACC-SPY Version '+XSVER);
  558.                                 new(p,Init(InfoWnd,XSIGO,34,false,''));
  559.                                 if p<>nil then p^.SetText('mit ObjectGEM '+VtoS(GOVersion)+' für PurePascal');
  560.                                 new(PButton,Init(InfoWnd,XSIOK,id_OK,true,'Schließt das INFO-Fenster.'))
  561.                             end
  562.                     end;
  563.                 if InfoWnd<>nil then InfoWnd^.MakeWindow
  564.             end;
  565.         ExitDlg:=false
  566.     end;
  567.  
  568.  
  569. function TXAccWindow.OK: boolean;
  570.  
  571.     begin
  572.         Application^.Quit;
  573.         OK:=true
  574.     end;
  575.  
  576.  
  577. function TXAccWindow.Help: boolean;
  578.  
  579.     begin
  580.         Application^.Alert(@self,1,NOTE,'Bringen Sie den Mauscursor über das Dialogelement, zu dem Sie Hilfe benötigen. Drücken Sie dann die <Help>- oder die rechte Maustaste.','  &OK  ');
  581.         Help:=false
  582.     end;
  583.  
  584.  
  585. procedure TAbout.Work;
  586.  
  587.     begin
  588.         PDialog(Parent)^.ExitDlg(XSWINFO)
  589.     end;
  590.  
  591.  
  592. procedure THelp.Work;
  593.  
  594.     begin
  595.         PDialog(Parent)^.Help
  596.     end;
  597.  
  598.  
  599. procedure TQuit.Work;
  600.  
  601.     begin
  602.         Application^.Quit
  603.     end;
  604.  
  605.  
  606. procedure THistory.Work;
  607.  
  608.     begin
  609.         with PXAccApplication(Application)^ do if HWind<>nil then HWind^.MakeWindow
  610.     end;
  611.  
  612.  
  613. procedure TSetup.Work;
  614.     var ed: PEdit;
  615.  
  616.     begin
  617.         if ADialog=nil then
  618.             begin
  619.                 new(ADialog,Init(PWindow(Parent),'SETUP (XAcc-Spy)',XSSETUP));
  620.                 if ADialog<>nil then
  621.                     begin
  622.                         new(ed,Init(ADialog,XSSHLEN,5,'Legt fest, wieviele Zeilen in der History gespeichert werden können'));
  623.                         new(PCheckBox,Init(ADialog,XSSHIST,true,'Bestimmt, ob die empfangenen Messages in der History mitprotokolliert werden sollen'));
  624.                         new(PCheckBox,Init(ADialog,XSSWIND,true,'Ist diese Checkbox markiert, wird beim Verlassen vom XAcc-Spy bzw. bei Anwahl von "INF speichern" die aktuelle Fensterposition und -größe gespeichert'));
  625.                         new(PInfButton,Init(ADialog,XSSINF,id_NoExit,true,'Nach einer Sicherheitsabfrage werden die aktuellen Einstellungen in der Datei XACCSPY.INF gespeichert'));
  626.                         new(PButton,Init(ADialog,XSSOK,id_OK,true,'Übernimmt die Einstellungen'));
  627.                         new(PButton,Init(ADialog,XSSABBR,id_Cancel,true,'Bricht den Dialog ab, ohne neue Einstellungen zu übernehmen'));
  628.                         if ed<>nil then
  629.                             ed^.SetValidator(new(PRangeValidator,Init(10,1999)));
  630.                         ADialog^.TransferBuffer:=@PXAccApplication(Application)^.tbuffer
  631.                     end
  632.             end;
  633.         if ADialog<>nil then ADialog^.MakeWindow
  634.     end;
  635.  
  636.  
  637. procedure TInfButton.Changed(AnIndx: integer; DblClick: boolean);
  638.     var tb: pointer;
  639.  
  640.     begin
  641.         if Application^.Alert(Parent,1,WAIT,'Wollen Sie XACCSPY.INF speichern?','  &Ja  | &Nein ')=1 then
  642.             begin
  643.                 with Parent^ do
  644.                     begin
  645.                         tb:=TransferBuffer;
  646.                         TransferBuffer:=@tbuf;
  647.                         TransferData(tf_GetData);
  648.                         TransferBuffer:=tb
  649.                     end;
  650.                 SliceMouse;
  651.                 if WritePrivateProfileString('History','Length',tbuf.hlen,'XACCSPY.INF') then
  652.                     begin
  653.                         SliceMouseNext;
  654.                         WritePrivateProfileInt('History','Save',tbuf.hprot,'XACCSPY.INF');
  655.                         SliceMouseNext;
  656.                         WritePrivateProfileInt('Setup','Save',tbuf.wsave,'XACCSPY.INF');
  657.                         if tbuf.wsave=bf_Checked then
  658.                             begin
  659.                                 SliceMouseNext;
  660.                                 WritePrivateProfileInt('Setup','Window.X',Parent^.Parent^.Curr.X,'XACCSPY.INF');
  661.                                 SliceMouseNext;
  662.                                 WritePrivateProfileInt('Setup','Window.Y',Parent^.Parent^.Curr.Y,'XACCSPY.INF');
  663.                                 SliceMouseNext;
  664.                                 WritePrivateProfileInt('Setup','Window.W',Parent^.Parent^.Curr.W,'XACCSPY.INF');
  665.                                 SliceMouseNext;
  666.                                 WritePrivateProfileInt('Setup','Window.H',Parent^.Parent^.Curr.H,'XACCSPY.INF');
  667.                                 if PXAccApplication(Application)^.HWind<>nil then
  668.                                     with PXAccApplication(Application)^.HWind^ do
  669.                                         begin
  670.                                             SliceMouseNext;
  671.                                             WritePrivateProfileInt('History','Window.X',Curr.X,'XACCSPY.INF');
  672.                                             SliceMouseNext;
  673.                                             WritePrivateProfileInt('History','Window.Y',Curr.Y,'XACCSPY.INF');
  674.                                             SliceMouseNext;
  675.                                             WritePrivateProfileInt('History','Window.W',Curr.W,'XACCSPY.INF');
  676.                                             SliceMouseNext;
  677.                                             WritePrivateProfileInt('History','Window.H',Curr.H,'XACCSPY.INF')
  678.                                         end
  679.                             end
  680.                     end;
  681.                 SavePrivateProfile;
  682.                 ArrowMouse
  683.             end
  684.     end;
  685.  
  686.  
  687. begin
  688.   XAccApplication.Init('XSPY','XAcc-Spy');
  689.   XAccApplication.Run;
  690.   XAccApplication.Done
  691. end.